Precision Software Appli…tions Silver Collection 1/Precision Software Applications Silver Collection Volume One (PSM) (1993).iso/tutor/s3bas11.arj/CHGMOD.BAS

BASIC Source File | 1993-05-29 | 14KB | 348 lines

'*************************************************
'* This example is for reading/setting file      *
'* attributes.  It also is an example of how     *
'* to read file names from the disk.  BC 7.1     *
'* and VB DOS all support the DIR$ function,     *
'* but QB does not, so we will low-level code    *
'* our own DIR function and call it READDIR      *
'*                                               *
'* This code is the copyright of George Spafford *
'*                                               *
'* v1.0  04/29/93  Initial Release               *
'*************************************************
'We use interrupt 21H and the following functions:
'
'   1AH                : Set DTA address
'   43H, Subfunction 1 : Set file attributes
'   4EH                : Find first matching file
'   4FH                : Find the next matching file
'
'===================================================

DEFINT A-Z             'make variables integer by default

TYPE RegType
     AX    AS INTEGER
     bx    AS INTEGER
     CX    AS INTEGER
     DX    AS INTEGER
     bp    AS INTEGER
     si    AS INTEGER
     di    AS INTEGER
     Flags AS INTEGER
END TYPE

TYPE RegTypeX
     AX    AS INTEGER
     bx    AS INTEGER
     CX    AS INTEGER
     DX    AS INTEGER
     bp    AS INTEGER
     si    AS INTEGER
     di    AS INTEGER
     Flags AS INTEGER
     DS    AS INTEGER
     es    AS INTEGER
END TYPE

TYPE F
     Buffer AS STRING * 21  'reserved for DOS
     Attrib AS STRING * 1   'file attribute
     Time   AS INTEGER      'file time
     Date   AS INTEGER      'file date
     Size   AS LONG         'file size
     Name   AS STRING * 13  'file name (12 + CHR$(0))
END TYPE

DIM Arg$(10)                'holds command arguments
DIM Finfo AS F              'holds located file info
DIM InRegs  AS RegType      'use InReg to hold all registers
                            'except segment registers
DIM OutRegs AS RegType      'Use OutReg to receive values
DIM InRegsX  AS RegTypeX    'use InReg to hold all registers
                            'including segment registers
DIM OutRegsX AS RegTypeX    'Use OutReg to receive values

DECLARE SUB INTERRUPT (intnum AS INTEGER, InReg AS RegType, OutReg AS RegType)
DECLARE SUB InterruptX (intnum AS INTEGER, InReg AS RegTypeX, OutReg AS RegTypeX)


'******** End of Declarations ********

Title$ = "S3 CHGMOD v1.0              Copyright George Spafford 04/29/93"
PRINT
PRINT Title$
PRINT
PRINT "Name", "Size", "Previous", "New"
PRINT

'The next line ensures that the COMMAND line is
'upper case and that left and right spaces are
'stripped.  The normal libraries usually do this
'for you, but some libraries (Crescent's PDQ) do
'not provide the same support.

CL$ = LTRIM$(RTRIM$(UCASE$(COMMAND$)))

IF CL$ = "" THEN GOTO CLHelp             'can not be NULL
IF INSTR(CL$, "?") > 0 THEN GOTO CLHelp  'they want help!

'okay, we now need to parse the command line for the
'proper elements.  I am going to use white-space (just
'a space) as the separator (delimitter) between
'commands and recognize the "/" as indicative of a
'switch.  One space will be added to the end of the
'command line to serve as the final delimitter.

CL$ = CL$ + " "

Start = 1                           'Byte to begin the parse at
Look = 1                            'where INSTR should start looking
                                    'for spaces
DO                                  'DO loop
   a = INSTR(Look, CL$, " ")        'store position of space found
                                    'after byte specified as Look
   IF a > 0 THEN                    'Did INSTR find a space?
      CFound = CFound + 1           'if so, add one to array counter
      Length = (a - Start)          'this is how long the argument is
      Arg$(CFound) = MID$(CL$, Start, Length)   'This just uses MID$ to grab it
      Start = a + 1                 'New start is A + 1
      Look = Start + 1              'INSTR needs to look for spaces one
                                    'byte further than where Start is
   END IF                           'end block if
LOOP UNTIL a = LEN(CL$)             'LOOP until A = the length of our command
                                    'line.  This condition will be true when
                                    'it processes the final space that we added

'Okay, now we have all of the arguments loaded in the ARG$() array.
'Here, you could test for the number of arguments found if you wanted
'to force the user to enter a certain number of them.  For example:
'       IF CFound < 2 then
'          Print "ERROR:  Usage is:  CHGMOD filename [/R+][/R-] ..."
'          Print
'          end
'       end if
'We will not do this here, because if the user does not enter anything on the
'command line, then we capture the condition with IF CL$="" THEN earlier.
'Also, if the user just enters the file name(s), we will display the current
'attributes assigned to that file(s).

IF CFound > 1 THEN                      'more that one arg?
   FOR N = 2 TO CFound                  'start with #2
       SELECT CASE Arg$(N)              'CASE check it
              CASE "/R+"                'set read only
                   SetReadOnly = 1
              CASE "/R-"                'remove RO
                   SetReadOnly = -1
              CASE "/S+"                'set system
                   SetSystem = 1
              CASE "/S-"                'remove system
                   SetSystem = -1
              CASE "/H+"                'set hidden
                   SetHidden = 1
              CASE "/H-"                'remove hidden
                   SetHidden = -1
              CASE "/A+"                'set archive
                   SetArchive = 1
              CASE "/A-"                'remove archive
                   SetArchive = -1
              CASE "/-"                 'remove all
                   Noattributes = 1
              CASE ELSE                 'if none of the above
                   GOTO CLHelp          'goto command help
       END SELECT                       'end the CASE
    NEXT N                              'process next argument
END IF                                  'end the block if

'Now, we get down to the hard core stuff.  Note, there are two ways
'to get directory entries.  The one NOT to use is INT 21H Function 11H.
'This uses the old File Control Blocks (FCB) and only operates in the
'current directory.  Function 11H does the initial match and 12H finds the
'next match.
'The method to use is INT 21H, Function 4EH and Function 4FH.
'This method makes use of handles and the Data Transfer Area (DTA).
'The DTA is an area in memory that stores the located file's
'attributes, file time, file date and file size.  When combined,
'this information uses the first 43 bytes of the DTA.

'First, we need to set the DTA address.
InRegsX.AX = &H1A00                     'Load AH with 1A
InRegsX.DS = VARSEG(Finfo)              'Load the segment address
                                        'to the DTA block into DS
InRegsX.DX = VARPTR(Finfo)              'Load the offset address to
                                        'the DTA block into DX

CALL InterruptX(&H21, InRegsX, OutRegsX)    'make the call

DIM Hold AS STRING * 65                 'assign a 64 + 1 byte buffer
                                        'this means 64 bytes data + 1 CHR$(0)
Hold = Arg$(1) + CHR$(0)                'File Name ended with ASCII 0
                                        'do not forget to add the CHR$(0) !!!!
                                        'The file name can contain wildcards.
InRegsX.AX = &H4E00                     'Function 4EH into AH
InRegsX.CX = 1 + 2 + 4 + 32             'Find matches of:
                                        'bit 0:  Read Only
                                        '    1:  Hidden
                                        '    2:  System
                                        '    5:  Archive
                                        'essentially, CX holds a attribute
                                        'that is used as a match as well as
                                        'the file specification.
InRegsX.DS = VARSEG(Hold)               'point to segment of HOLD$
InRegsX.DX = VARPTR(Hold)               'point to offset of HOLD$

'SPECIAL NOTE:  Since BASIC can move strings around, determine the Segment and
'               offsets right before you use them.

CALL InterruptX(&H21, InRegsX, OutRegsX)
IF OutRegsX.Flags AND 1 THEN            'If bit 0 is on, the carry flag is
                                        'set which means an error occurred.

   IF OutRegsX.AX = 2 THEN              '2 means a path error
      PRINT "Path Not Found"            '18 means not attributes matched.
                                        'We will skip 18.
   END IF
   PRINT "No Files match:  "; FileSpec$
   PRINT
   END                                  'end if none are found
END IF

'If we make it to this point, we must assume that there exists
'either a single match or multiple matches to the file specification
'that we entered.

DO
   Found = Found + 1                    'add one to the number of files found
   attr = ASC(Finfo.Attrib)
   Current$ = ""
   RO = 0
   Hidden = 0
   SystemA = 0
   Archive = 0

                                        'bit   attr
   IF attr AND 1 THEN                   ' 0    Read-Only
      RO = 1
      Current$ = Current$ + "R"
   END IF
   IF attr AND 2 THEN                   ' 1    Hidden
      Hidden = 2
      Current$ = Current$ + "H"
   END IF
   IF attr AND 4 THEN                   ' 2    System
      SystemA = 4
      Current$ = Current$ + "S"
   END IF
   IF attr AND 32 THEN                  ' 5    Archive
      Archive = 32
      Current$ = Current$ + "A"
   END IF

   a = INSTR(Finfo.Name, CHR$(0))       'find the CHR$(0)
                                        'the next line pulls it out
   IF a > 0 THEN Out$ = LEFT$(Finfo.Name, (a - 1))

   IF CFound > 1 THEN
      IF SetReadOnly = 1 THEN RO = 1
      IF SetReadOnly = -1 THEN RO = 0
      IF SetHidden = 1 THEN Hidden = 2
      IF SetHidden = -1 THEN Hidden = 0
      IF SetSystem = 1 THEN SystemA = 4
      IF SetSystem = -1 THEN SystemA = 0
      IF SetArchive = 1 THEN Archive = 32
      IF SetArchive = -1 THEN Archive = 0

      'Remember, remember, remember, we are setting bits
      'here that have a corresponding integer depiction.
      'Thus, we add them together.

      NewAttrib = RO + Hidden + SystemA + Archive

      IF Noattributes THEN NewAttrib = 0

      'Lets set the new attributes

      InRegsX.AX = &H43 * 256           'load 43H into AH
      InRegsX.AX = InRegsX.AX OR &H1    'load 1H into AL

      'Let me explain the previous two lines a bit better.
      'First, we loaded &H43 into AH by multiplying it by 256.
      'Remember?  AX is a 16 bit register that is made up of two"
      '8-bit registers that can be accessed independently.  Frankly,"
      'I think we should have been given direct access to the 8-bit"
      'registers, but we do not.
      'Load AH first and then load AL by using the OR operator"
      'Using OR will not destroy the value in AH.  If you are
      'still scratching your head as to why we multiplied the
      '43H by 256 it is because 8 enabled bits = 256.  Look in the
      'print tutorial .DOC file for a good explanation.

      InRegsX.CX = NewAttrib
      InRegsX.DS = VARSEG(Finfo.Name)
      InRegsX.DX = VARPTR(Finfo.Name)
      CALL InterruptX(&H21, InRegsX, OutRegsX)
      IF OutRegsX.Flags AND 1 THEN
         PRINT Out$, Finfo.Size, Current$
         IF AX = 1 THEN PRINT "Unknown function code"
         IF AX = 5 THEN PRINT "Attribute can not be changed"
         PRINT
         END
      END IF
   END IF
   New$ = ""
   IF RO THEN New$ = New$ + "R"
   IF Hidden THEN New$ = New$ + "H"
   IF SystemA THEN New$ = New$ + "S"
   IF Archive THEN New$ = New$ + "A"

   IF Noattributes THEN New$ = ""

   PRINT Out$, Finfo.Size, Current$, New$

   'Next we look for the next matching file using function 4F.
   'If we get an error in the Carry flag bit, we will assume that
   'we have read in all of the matching file names.

   InRegsX.AX = &H4F00                  'load AH with 4F
   CALL InterruptX(&H21, InRegsX, OutRegsX)
   IF OutRegsX.Flags AND 1 THEN         'look for error
      EndMatch = 1
   END IF
LOOP UNTIL EndMatch                     'if endmatch, then exit the loop

'If we have found all of our matches, it is time to go bye-bye.

END


'The next fragment is just typical of how I do my command line help.
'In 99.9% of my programs, if the user does not enter any parameters,
'enters an unknown parameter, or a "?" on the command line, then I throw
'them into a small code segment that explains how to run the program.

CLHelp:
    CLS
    PRINT Title$
    PRINT
    PRINT "USAGE:  CHGMOD filename [/R+][/R-][/H+][/H-][/S+][/S-][/A+][/A-]"
    PRINT
    PRINT "               filename  <- this is the file specification that you"
    PRINT "                            either wish to view or change"
    PRINT ""
    PRINT "               [/letter + or -]"
    PRINT "                 R   =  Read-Only"
    PRINT "                 H   =  Hidden"
    PRINT "                 S   =  System"
    PRINT "                 A   =  Archive"
    PRINT "                 +   =  adds the attribute to the file(s)"
    PRINT "                 -   =  removes the attribute from the file(s)"
    PRINT
    PRINT "Have a thrilling day"
    END